home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / win / pascal / stadll.exe / STATOBJ.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-06-18  |  8.8 KB  |  301 lines
  1. {
  2.    This unit contains an object which creates a modeless "status" dialog box.
  3.    The dialog box displays a percentage complete and a comment.  It allows the
  4.    user to cancel the current task.  It can be used in a DLL if so desired.
  5.    One consideration, if it is used in a DLL is that I have been unsuccessful
  6.    in my attempts to allow more than one instance of this object to be used
  7.    at once.  (I may fix this in the future, but for my current applications,
  8.    this is not a problem.)
  9.  
  10.    June 18/93
  11.    Bradley Plett
  12.    CIS ID: 71075,2010
  13. }
  14. UNIT statobj;
  15.  
  16. INTERFACE
  17.  
  18. USES
  19.   strings, wintypes, winprocs, windos;
  20.  
  21. {$R status.res}
  22.  
  23. TYPE
  24.   stat_dlg = OBJECT
  25.       FUNCTION init(inhwnd : hwnd) : bool;
  26.       FUNCTION cancelled : boolean;
  27.       PROCEDURE update(inperc : REAL; incmt : pchar);
  28.       PROCEDURE done;
  29.     PRIVATE
  30.       {parent window}
  31.       parent_hwnd : hwnd;
  32.       {message handling procedure}
  33.       msg_proc : tFarProc;
  34.     END;   {stat_dlg}
  35.  
  36. IMPLEMENTATION
  37.  
  38. CONST
  39.   BWCCInst : tHandle = tHandle(0);
  40.   BorButton : pchar = 'BorBtn';
  41.   {dialog box handle}
  42.   stdlg_hwnd : hwnd = 0;
  43.  
  44. VAR
  45.   {variable indicating the user's desire to cancel the task}
  46.   user_abort : boolean;
  47.  
  48. FUNCTION LoadBWCC : Bool;
  49. {
  50.    Check to see if BWCC is available.
  51. }
  52.   VAR
  53.     aWndClass: tWndClass;
  54.     prevMode: word;
  55.   BEGIN   {LoadBWCC}
  56.     IF (BWCCInst = 0) THEN
  57.       BEGIN
  58.         prevMode:= SetErrorMode($8000); {SEM_NoOpenFileErrorBox}
  59.         BWCCInst:= LoadLibrary('BWCC.DLL');
  60.         SetErrorMode(prevMode);
  61.         IF (BWCCInst < 32) THEN
  62.           BEGIN
  63.             LoadBWCC:= False;
  64.             BWCCInst:= 0;
  65.             Exit
  66.           END;
  67.       END;
  68.     LoadBWCC:= GetClassInfo(System.hInstance,BorButton,aWndClass)
  69.   END;   {LoadBWCC}
  70.  
  71. PROCEDURE UnLoadBWCC;
  72. {
  73.    Unload BWCC if it's loaded.
  74. }
  75.   BEGIN   {UnLoadBWCC}
  76.     IF (BWCCInst <> 0) THEN
  77.       BEGIN
  78.         FreeLibrary(BWCCInst);
  79.         BWCCInst:= 0
  80.       END;
  81.   END;   {UnLoadBWCC}
  82.  
  83. FUNCTION stat_dlg_proc(Dlg : hWnd; msg : word;
  84.                        wParam : word; lParam : longint) : longint; EXPORT;
  85. {
  86.    Handle the dialog box messages.
  87. }
  88.   BEGIN   {stat_dlg_proc}
  89.     stat_dlg_proc := 0;
  90.     CASE msg OF
  91.         wm_InitDialog :
  92.           BEGIN
  93.             {get rid of the "Close" menu option}
  94.             DeleteMenu(GetSystemMenu(dlg, false), sc_close, mf_bycommand);
  95.             stat_dlg_proc := -1;
  96.           END;   {wm_InitDialog}
  97.         wm_Command : BEGIN
  98.             {if the user selected "Cancel", set the global variable}
  99.             IF (wParam = id_Cancel) THEN
  100.               user_abort := true;
  101.           END;   {wm_Command}
  102.       END;   {case}
  103.   END;   {stat_dlg_proc}
  104.  
  105. FUNCTION stat_dlg.init(inhwnd : hwnd) : bool;
  106. {
  107.    Initialize the object, especially its variables, and try to create the
  108.    dialog box.
  109. }
  110.  
  111.   BEGIN   {stat_dlg.init}
  112.  
  113.     {initialize variables}
  114.     init := false;
  115.     IF (stdlg_hwnd <> 0) THEN
  116.       exit;
  117.     user_abort := false;
  118.     parent_hwnd := inhwnd;
  119.     msg_proc := NIL;
  120.  
  121.     {set up message handling procedure}
  122.     msg_proc := MakeProcInstance(@stat_dlg_proc, hInstance);
  123.     IF (msg_proc = NIL) THEN
  124.       messagebox(0, 'Problems making procedure instance', 'Error',
  125.                  mb_iconstop + mb_ok)
  126.     ELSE
  127.       BEGIN
  128.  
  129.         {create the dialog box, using Borland Custom Controls if available}
  130.         IF LoadBWCC THEN
  131.           stdlg_hwnd := CreateDialog(hInstance, 'StatusB',
  132.                                      parent_hwnd, msg_proc)
  133.         ELSE
  134.           stdlg_hwnd := CreateDialog(hInstance, 'Status',
  135.                                      parent_hwnd, msg_proc);
  136.         IF (stdlg_hwnd = 0) THEN
  137.           BEGIN
  138.             messagebox(0, 'Could not create a window', 'Error',
  139.                        mb_iconstop + mb_ok);
  140.             {clean up}
  141.             done;
  142.           END
  143.         ELSE
  144.           BEGIN
  145.             {display the dialog box and disable the parent window}
  146.             ShowWindow(stdlg_hwnd, sw_show);
  147.             EnableWindow(parent_hwnd, false);
  148.             init := true;
  149.           END;   {else}
  150.       END;   {else}
  151.  
  152.   END;   {stat_dlg.init}
  153.  
  154. FUNCTION stat_dlg.cancelled : boolean;
  155. {
  156.    Check Windows messages and check if user selected "cancel".
  157. }
  158.   VAR
  159.     message : tmsg;                    {messages to process}
  160.   BEGIN   {stat_dlg.cancelled}
  161.     {check if there's a message waiting}
  162.     WHILE PeekMessage(Message, 0, 0, 0, pm_remove) DO
  163.       BEGIN
  164.         {handle messages for the dialog box and pass on others}
  165.         IF (stdlg_hwnd = 0) OR (NOT isdialogmessage(stdlg_hwnd, message)) THEN
  166.           BEGIN
  167.             TranslateMessage(Message);
  168.             DispatchMessage(Message);
  169.           END;   {if}
  170.       END;
  171.     cancelled := user_abort;
  172.   END;   {stat_dlg.cancelled}
  173.  
  174. PROCEDURE stat_dlg.update(inperc : REAL; incmt : pchar);
  175. {
  176.    Display the percentage as a bar, the percentage as text, and a comment.
  177. }
  178.  
  179.   CONST
  180.     rgb_Blue        = $00FF0000;       {blue rectangle interior}
  181.     id_prect = 101;                    {rectangle id}
  182.     id_ptext = 102;                    {% text id}
  183.     id_pcnt = 103;                     {count id}
  184.  
  185.   VAR
  186.     dc : hdc;                          {device context}
  187.     tmps : ARRAY [0..20] OF char;         {string for output}
  188.     NewBrush,
  189.     OldBrush:  HBrush;                 {brushes used for rectangle interior}
  190.     NewPen  ,
  191.     OldPen  :  HPen;                   {pens used for rectangle outline}
  192.     stat_rect : trect;                 {rectangle for % bar}
  193.     rect_right : integer;              {right coordinate of bar}
  194.     rect_hwnd : hwnd;                  {rectangle window handle}
  195.     tmp_point : tpoint;                {used for coordinate conversion}
  196.  
  197.   BEGIN   {stat_dlg.update}
  198.  
  199.     {only update display if we have a valid window}
  200.     IF (stdlg_hwnd <> 0) THEN
  201.       BEGIN
  202.  
  203.         {get device context}
  204.         dc := getdc(stdlg_hwnd);
  205.  
  206.         {get rectangle's handle}
  207.         rect_hwnd := GetDlgItem(stdlg_hwnd, id_prect);
  208.  
  209.         {get rectangle's coordinates}
  210.         GetwindowRect(rect_hwnd, stat_rect);
  211.  
  212.         {convert coordinates to be relative to the dialog box}
  213.         WITH stat_rect DO
  214.           BEGIN
  215.             tmp_point.x := left;
  216.             tmp_point.y := top;
  217.             ScreenToClient(stdlg_hwnd, tmp_point);
  218.             left := tmp_point.x + 1;
  219.             top := tmp_point.y + 1;
  220.             tmp_point.x := right;
  221.             tmp_point.y := bottom;
  222.             ScreenToClient(stdlg_hwnd, tmp_point);
  223.             right := tmp_point.x - 1;
  224.             bottom := tmp_point.y - 1;
  225.           END;   {with}
  226.  
  227.         {save old brush and select a new one for painting the bar}
  228.         NewBrush := CreateSolidBrush(rgb_blue);
  229.         IF (NewBrush = 0) THEN   { Use the new brush if it was made }
  230.           OldBrush := 0
  231.         ELSE
  232.           OldBrush := SelectObject(DC, NewBrush);
  233.  
  234.         {save old pen and select a new one for the bar's outline}
  235.         NewPen := CreatePen(ps_Solid, 1, rgb_blue);
  236.         IF (NewPen = 0) THEN
  237.           OldPen := 0
  238.         ELSE
  239.           OldPen := SelectObject(DC, NewPen);
  240.  
  241.         {calculate the bar's right coordinate}
  242.         rect_right := round(inperc / 100.0 *
  243.                             (stat_rect.right - stat_rect.left) +
  244.                             stat_rect.left);
  245.  
  246.         {draw the bar}
  247.         rectangle(dc, stat_rect.left, stat_rect.top,
  248.                       rect_right, stat_rect.bottom);
  249.  
  250.         {restore the old brush and pen}
  251.         IF (OldBrush <> 0) THEN   { Restore the original brush now! }
  252.           BEGIN
  253.             SelectObject(DC, OldBrush);
  254.             DeleteObject(NewBrush)
  255.           END;   {if}
  256.         IF (OldPen <> 0) THEN
  257.           BEGIN
  258.             SelectObject(DC, OldPen);
  259.             DeleteObject(NewPen)
  260.           END;   {if}
  261.  
  262.         {display the % complete in text form}
  263.         str(inperc:1:0, tmps);
  264.         strcat(tmps, '%');
  265.         SetDlgItemText(stdlg_hwnd, id_ptext, tmps);
  266.  
  267.         {display the comment}
  268.         SetDlgItemText(stdlg_hwnd, id_pcnt, incmt);
  269.  
  270.         {release the device context}
  271.         releasedc(stdlg_hwnd, dc);
  272.  
  273.       END;   {if}
  274.  
  275.   END;   {stat_dlg.update}
  276.  
  277. PROCEDURE stat_dlg.done;
  278. {
  279.    Clean up the object.
  280. }
  281. var tmps : array [0..20] of char; {?????}
  282.   BEGIN   {stat_dlg.done}
  283.  
  284.     {enable the parent window and get rid of the dialog box}
  285.     EnableWindow(parent_hwnd, true);
  286.     IF (stdlg_hwnd <> 0) THEN
  287.       DestroyWindow(stdlg_hwnd);
  288.     {reset so it can be used again}
  289.     stdlg_hwnd := 0;
  290.  
  291.     {get rid of the message handling procedure's handle}
  292.     IF (msg_proc <> NIL) THEN
  293.       FreeProcInstance(msg_proc);
  294.  
  295.     {unload Borland Custom Control library}
  296.     UnLoadBWCC;
  297.  
  298.   END;   {stat_dlg.done}
  299.  
  300. BEGIN   {statobj}
  301. END.   {statobj}